Skunkware 98/Skunkware 98.iso/src/interp/perl5.005.tar.gz/perl5.005.tar/perl5.005/pod/buildtoc

Text File | 1998-07-22 | 4KB | 242 lines

use File::Find;
use Cwd;
use Text::Wrap;

sub output ($);

@pods = qw(
       perl perlfaq perlfaq1 perlfaq2 perlfaq3 perlfaq4 perlfaq5
       perlfaq6 perlfaq7 perlfaq8 perlfaq9 perldelta perldata
       perlsyn perlop perlre perlrun perlfunc perlvar perlsub
       perlmod perlmodlib perlmodinstall perlform perllocale perlref perldsc
       perllol perltoot perlobj perltie perlbot perlipc perldebug
       perldiag perlsec perltrap perlport perlstyle perlpod perlbook
       perlembed perlapio perlxs perlxstut perlguts perlcall
       perlhist
      );

for (@pods) { s/$/.pod/ }

$/ = '';
@ARGV = @pods;

($_= <<EOPOD2B) =~ s/^\t//gm && output($_);

    =head1 NAME

    perltoc - perl documentation table of contents

    =head1 DESCRIPTION

    This page provides a brief table of contents for the rest of the Perl
    documentation set.  It is meant to be scanned quickly or grepped
    through to locate the proper section you're looking for.

    =head1 BASIC DOCUMENTATION

EOPOD2B
#' make emacs happy

podset(@pods);

find \&getpods => qw(../lib ../ext);

sub getpods {
    if (/\.p(od|m)$/) {
    # Skip .pm files that have corresponding .pod files, and Functions.pm.
    return if /(.*)\.pm$/ && -f "$1.pod";
    my $file = $File::Find::name;
    return if $file eq '../lib/Pod/Functions.pm'; # Used only by pod itself

    die "tut $name" if $file =~ /TUT/;
    unless (open (F, "< $_\0")) {
        warn "bogus <$file>: $!";
        system "ls", "-l", $file;
    }
    else {
        my $line;
        while ($line = <F>) {
        if ($line =~ /^=head1\s+NAME\b/) {
            push @modpods, $file;
            #warn "GOOD $file\n";
            return;
        }
        }
        warn "EVIL $file\n";
    }
    }
}

die "no pods" unless @modpods;

for (@modpods) {
    #($name) = /(\w+)\.p(m|od)$/;
    $name = path2modname($_);
    if ($name =~ /^[a-z]/) {
    push @pragmata, $_;
    } else {
    if ($done{$name}++) {
        # warn "already did $_\n";
        next;
    }
    push @modules, $_;
    push @modname, $name;
    }
}

($_= <<EOPOD2B) =~ s/^\t//gm && output($_);



    =head1 PRAGMA DOCUMENTATION

EOPOD2B

podset(sort @pragmata);

($_= <<EOPOD2B) =~ s/^\t//gm && output($_);



    =head1 MODULE DOCUMENTATION

EOPOD2B

podset( @modules[ sort { $modname[$a] cmp $modname[$b] } 0 .. $#modules ] );

($_= <<EOPOD2B) =~ s/^\t//gm;


    =head1 AUXILIARY DOCUMENTATION

    Here should be listed all the extra programs' documentation, but they
    don't all have manual pages yet:

    =item a2p

    =item s2p

    =item find2perl

    =item h2ph

    =item c2ph

    =item h2xs

    =item xsubpp

    =item pod2man

    =item wrapsuid


    =head1 AUTHOR

    Larry Wall <F<larry\@wall.org>>, with the help of oodles
    of other folks.


EOPOD2B
output $_;
output "\n";                    # flush $LINE
exit;

sub podset {
    local @ARGV = @_;

    while(<>) {
    if (s/^=head1 (NAME)\s*/=head2 /) {
        $pod = path2modname($ARGV);
        unitem();
        unhead2();
        output "\n \n\n=head2 ";
        $_ = <>;
        if ( /^\s*$pod\b/ ) {
        s/$pod\.pm/$pod/;       # '.pm' in NAME !?
        output $_;
        } else {
        s/^/$pod, /;
        output $_;
        }
        next;
    }
    if (s/^=head1 (.*)/=item $1/) {
        unitem(); unhead2();
        output $_; nl(); next;
    }
    if (s/^=head2 (.*)/=item $1/) {
        unitem();
        output "=over\n\n" unless $inhead2;
        $inhead2 = 1;
        output $_; nl(); next;

    }
    if (s/^=item ([^=].*)\n/$1/) {
        next if $pod eq 'perldiag';
        s/^\s*\*\s*$// && next;
        s/^\s*\*\s*//;
        s/\s+$//;
        next if /^[\d.]+$/;
        next if $pod eq 'perlmodlib' && /^ftp:/;
        ##print "=over\n\n" unless $initem;
        output ", " if $initem;
        $initem = 1;
        s/\.$//;
        s/^-X\b/-I<X>/;
        output $_; next;
    }
    }
}

sub path2modname {
    local $_ = shift;
    s/\.p(m|od)$//;
    s-.*?/(lib|ext)/--;
    s-/-::-g;
    s/(\w+)::\1/$1/;
    return $_;
}

sub unhead2 {
    if ($inhead2) {
    output "\n\n=back\n\n";
    }
    $inhead2 = 0;
    $initem  = 0;
}

sub unitem {
    if ($initem) {
    output "\n\n";
    ##print "\n\n=back\n\n";
    }
    $initem = 0;
}

sub nl {
    output "\n";
}

my $NEWLINE;    # how many newlines have we seen recently
my $LINE;    # what remains to be printed

sub output ($) {
    for (split /(\n)/, shift) {
    if ($_ eq "\n") {
        if ($LINE) {
        print wrap('', '', $LINE);
        $LINE = '';
        }
        if ($NEWLINE < 2) {
        print;
        $NEWLINE++;
        }
    }
    elsif (/\S/ && length) {
        $LINE .= $_;
        $NEWLINE = 0;
    }
    }
}